home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SAVESCRN.SWG / 0009_SAVE9.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  165 lines
  1. {
  2. > Basically all I'm asking For are SaveScreen and RestoreScreen Procedures.
  3. > Procedures capable of just partial screen saves and restores would be
  4. > even better, but anything will do!  :-)
  5. }
  6.  
  7. Unit ScrUnit;
  8.  
  9. Interface
  10.  
  11. Const
  12.   MaxPages  = 20;
  13. Type
  14.   PageType  = Array [1..50,1..80] Of Word;
  15.   PageArray = Array [1..MaxPages] Of ^PageType;
  16. Var
  17.   Screen    : ^PageType;
  18.   ScrPages  : PageArray;
  19.   PageInMem : Array [1..MaxPages] Of Boolean;
  20.   VideoMode : ^Byte;
  21.   UseDisk   : Boolean;
  22.  
  23. Procedure InitPages(Pages : Byte);
  24. Procedure DeInitPages;
  25. Procedure StoreScreen(Page : Byte);
  26. Procedure RestoreScreen(Page : Byte);
  27.  
  28. Implementation
  29. {$IFNDEF VER70}
  30. Const Seg0040      = $0040;
  31.       SegB000      = $B000;
  32.       SegB800      = $B800;
  33. {$endIF}
  34.  
  35. Var
  36.   MPages       : Byte;
  37.   SaveExitProc : Pointer;
  38.  
  39. Function FStr(Num : LongInt) : String;
  40. Var Dummy : String;
  41. begin
  42.   Str(Num,Dummy);
  43.   FStr := Dummy;
  44. end;
  45.  
  46. Procedure InitPages;
  47. Var
  48.   Loop : Byte;
  49. begin
  50.   If Pages>MaxPages Then
  51.     Pages := MaxPages;
  52.   For Loop:=1 To Pages Do
  53.   If (MaxAvail>=SizeOf(PageType)) And (Not UseDisk) Then
  54.   begin
  55.     PageInMem[Loop] := True;
  56.     GetMem(ScrPages[Loop],SizeOf(PageType));
  57.   end
  58.   Else
  59.   begin
  60.     PageInMem[Loop] := False;
  61.     ScrPages[Loop]  := NIL;
  62.   end;
  63.   MPages := Pages;
  64. end;
  65.  
  66. Procedure DeInitPages;
  67. Var Loop : Byte;
  68. begin
  69.   If MPages>0 Then
  70.     For Loop:=MPages DownTo 1 Do
  71.       If PageInMem[Loop] Then
  72.       begin
  73.         Release(ScrPages[Loop]);
  74.         PageInMem[Loop] := False;
  75.       end;
  76.   MPages := 0;
  77. end;
  78.  
  79. Procedure StoreScreen;
  80. Var
  81.   F : File Of PageType;
  82. begin
  83.   If Page<=MPages Then
  84.   begin
  85.     If PageInMem[Page] Then
  86.       Move(Screen^,ScrPages[Page]^,SizeOf(PageType))
  87.     Else
  88.     begin
  89.       Assign(F,'SCR'+FStr(Page)+'.$$$');
  90.       ReWrite(F);
  91.       If IOResult=0 Then
  92.       begin
  93.         Write(F,Screen^);
  94.         Close(F);
  95.       end;
  96.     end;
  97.   end;
  98. end;
  99.  
  100. Procedure RestoreScreen;
  101. Var
  102.   F : File Of PageType;
  103. begin
  104.   If Page<=MPages Then
  105.   begin
  106.     If PageInMem[Page] Then
  107.       Move(ScrPages[Page]^,Screen^,SizeOf(PageType))
  108.     Else
  109.     begin
  110.       Assign(F,'SCR'+FStr(Page)+'.$$$');
  111.       Reset(F);
  112.       If IOResult=0 Then
  113.       begin
  114.         Read(F,Screen^);
  115.         Close(F);
  116.       end;
  117.     end;
  118.   end;
  119. end;
  120.  
  121. {$F+}
  122. Procedure ScreenExitProc;
  123. Var
  124.   Loop : Byte;
  125.   F    : File;
  126. begin
  127.   ExitProc := SaveExitProc;
  128.   If MPages>0 Then
  129.     For Loop:=1 To MPages Do
  130.     begin
  131.       Assign(F,'SCR'+FStr(Loop)+'.$$$');
  132.       Erase(F);
  133.       If IOResult<>0 Then;
  134.     end;
  135. end;
  136. {$F-}
  137.  
  138. begin
  139.   VideoMode := Ptr(Seg0040,$0049);
  140.   If VideoMode^=7 Then
  141.     Screen := Ptr(SegB000,$0000)
  142.   Else
  143.     Screen := Ptr(SegB800,$0000);
  144.   MPages := 0;
  145.   UseDisk := False;
  146.   SaveExitProc := ExitProc;
  147.   ExitProc := @ScreenExitProc;
  148. end.
  149.  
  150. (*
  151. This simple Unit is able to store up to 20 screens. If there is enough free
  152. heap all screens are stored to heap which is Really fast. If there is not
  153. enough free heap or UseDisk=True all screens are stored virtually to disk. This
  154. method isn't very fast, of course, but it helps you to save heap.
  155.  
  156. Use this Unit as follows:
  157.  
  158. Program ThisIsMyProgram;
  159. Uses Screen;
  160. begin
  161.   InitPages(5);        { initialize 5 pages }
  162.   {...}                { this is on you }
  163. end.
  164. *)
  165.